library(plyr)
library(pander)
library(edgeR)
library(knitr)
library(VennDiagram)
library(tinytex)
library(RVAideMemoire)
## functions
source("functions/vennDia.R")
source("functions/staxlab.R")
source("functions/error.bar.R")
source("functions/variability_table.R")
design <- read.table("Database_S1.txt", header=T)   # Database_S1.xlsx exported as tab-delimited text file
rownames(design) <- design$sample_list_its
## experimental factors
design$sample_type <- factor(design$sample_type, levels=c("Soil","Rhizo","Root"))
design$plant_genotype <- factor(design$plant_genotype, levels=c("no","WT","bx1"))
# levels(design$plant_genotype)
## sample groups
design$groups <- as.factor(paste(design$plant_genotype, design$sample_type, design$soil, sep="_"))
design$groups <- factor(design$groups, levels=c("no_Soil_field",
"WT_Rhizo_field", "WT_Root_field",
"bx1_Rhizo_field", "bx1_Root_field",
"WT_Rhizo_BX+", "WT_Root_BX+",
"WT_Rhizo_BX-", "WT_Root_BX-") )
levels(design$groups)[1] <- "field_soil"
# table(design$groups)    # number of reps per sample group
## defining colors for sample groups
design$cols <- design$groups
levels(design$cols) <- c("dimgrey", "gold", "gold2", "palegreen2", "palegreen3",
"gold", "gold2", "palegreen2", "palegreen3")
fOTU_table <- "its_all_samples_trimmed_qfiltered_renamed_derep_ab5_otu.tab"   # remove "#OTU ID" from the table manually
all_fDAT <- read.table( fOTU_table, row.names=1, sep="\t", header=T, blank.lines.skip = FALSE)
# all_fDAT[1:5, 50:55]
## assuring oberlap between otu_table and design file
# design$sample_list_its[50:55]
fDAT <- all_fDAT[, rownames(design) ]
# Root_18 (=R16_ITS2_F50_ITS1F) removed due to very low sequence coverage
# sort(colSums(fDAT), decr=T)
fDAT <- fDAT[ , ! colnames(fDAT) %in% "R16_ITS2_F50_ITS1F" ]
design <- design[colnames(fDAT), ]
## replacing "OTU" with "fOTU"
rownames(fDAT) <- gsub("OTU","fOTU", rownames(fDAT) )
### OTU table
# fDAT[1:5, 50:55]
fTAX <- read.table( "UNITE_tax_forR.txt" , row.names=1, sep="\t", blank.lines.skip = FALSE)
rownames(fTAX) <- gsub("OTU","fOTU", rownames(fTAX) )
## fTAX object
colnames(fTAX) <- c("kingdom", "phylum", "class", "order", "family", "genus", "species", "conf")
fTAX$kingdom <- gsub("k__","", fTAX$kingdom )
fTAX$phylum <- gsub("p__","", fTAX$phylum )
fTAX$class <- gsub("c__","", fTAX$class )
fTAX$order <- gsub("o__","", fTAX$order )
fTAX$family <- gsub("f__","", fTAX$family )
fTAX$genus <- gsub("g__","", fTAX$genus )
fTAX$species <- gsub("s__","", fTAX$species )
fTAX[fTAX=="Unassignable"] <- "unassigned"
fTAX[fTAX=="Unclassified"] <- "unassigned"
fTAX[fTAX=="unidentified"] <- "unassigned"
fTAX[fTAX==""] <- "unassigned"
## define OTUs for removal
# table(fTAX$kingdom)
# unique(fTAX$kingdom)
fOTU_to_remove <- c(rownames(fTAX[fTAX$kingdom=="Protista",]),
rownames(fTAX[fTAX$kingdom=="Plantae",]),
rownames(fTAX[fTAX$kingdom=="Protozoa",]),
rownames(fTAX[fTAX$kingdom=="Animalia",]),
rownames(fTAX[fTAX$kingdom=="unassigned",]) )
# unique(fTAX$phylum)
# unique(fTAX$family)
## remove these from otu and tax table
fDAT <- fDAT[-which(rownames(fDAT) %in% fOTU_to_remove),]
fTAX <- fTAX[rownames(fDAT),]
## add OTU_ID to taxonomy file
fTAX$OTU_ID <- rownames(fTAX)
### Taxonomy table
# dim(fTAX)
# fTAX[1:5, c(2,4,6)]
### Field experiment (sum, range, median)
# sum(colSums(fDAT)[rownames(design)[design$exp=="field"]])
# range(colSums(fDAT)[rownames(design)[design$exp=="field"]])
# median(colSums(fDAT)[rownames(design)[design$exp=="field"]])
### Feedback experiment (sum, range, median)
# sum(colSums(fDAT)[rownames(design)[design$exp=="feedback"]])
# range(colSums(fDAT)[rownames(design)[design$exp=="feedback"]])
# median(colSums(fDAT)[rownames(design)[design$exp=="feedback"]])
## nr of sequences per sample group
par(mar=c(8,6,4,4), oma=c(0,0,0,0))
# library(sciplot)
bargraph.CI(design$groups, colSums(fDAT),
las=2, ylab="nr of high quality sequences", cex.lab=.7, cex.axis=.7, cex.names=.7,
err.width=.05,
border=NA, col=c(levels(design$cols), levels(design$cols)[2:5]))
## stats
# library(coin)
kruskal_test(colSums(fDAT) ~ design$groups)
## data normalization
# total sum as %
fDAT_norm <- t(t(fDAT)/colSums(fDAT)) * 100
fDAT_norm <- fDAT_norm[rowSums(fDAT_norm) > 0,]
# dim(fDAT_norm)
# rarefication with library(vegan)
set.seed(3920)     # 3920 = zip code of Zermatt with lovely Matterhorn
fDAT_rare <- t(rrarefy(t(fDAT), min(colSums(fDAT))))
# fDAT_rare <- t(rrarefy(t(fDAT), sort(colSums(fDAT))[[2]] ))    # remove sample root18 (few reads only)
## Phyloseq object
# library(phyloseq)
# library(ggplot2)
# library(plyr)
all_phy <- phyloseq(sample_data(design),
otu_table(fDAT_rare, taxa_are_rows=T),
tax_table(as.matrix(fTAX[rownames(fDAT_rare),])) )
### unconstrained ordination, PCoA
all_PCoA_bray <- ordinate(all_phy, method="PCoA", distance="bray")
p0 <- plot_ordination(all_phy, all_PCoA_bray, shape="sample_type", color="exp")
p0 <- p0 + geom_point(size=3)#, alpha=0.75)
p0 <- p0 + scale_color_manual(values=c("cornflowerblue", "coral2"))
# p0 <- p0 + ggtitle("PCoA on Bray-Curtis distances")
par(mar=c(4,4,4,4), oma=c(4,4,4,4))
print(p0)
### design
design_field <- droplevels(design[design$exp=="field",])
# simplifying names of samples groups
levels(design_field$groups) <- c("field_soil","WT_Rhizo",  "WT_Root", "bx1_Rhizo", "bx1_Root")
# library(pander)
design_field_summary <- table(design_field$groups)
pander(design_field_summary)
### data
fDAT_field <- fDAT[, rownames(design_field) ]
# range(colSums(fDAT_field))
# dim(fDAT_field)
## data normalization
# total sum as %
fDAT_field_norm <- t(t(fDAT_field)/colSums(fDAT_field)) * 100
fDAT_field_norm <- fDAT_field_norm[rowSums(fDAT_field_norm) > 0,]
# dim(fDAT_field_norm)
# rarefication, library(vegan)
set.seed(3920)     # 3920 = zip code of Zermatt with lovely Matterhorn
fDAT_field_rare <- t(rrarefy(t(fDAT_field), min(colSums(fDAT_field)) ))
# remove rows having a sum count = 0
fDAT_field_rare <- fDAT_field_rare[rowSums(fDAT_field_rare) >= 1,]
# dim(fDAT_field_rare)
## Phyloseq object
# library(phyloseq)
# library(ggplot2)
# library(plyr)
field_phy <- phyloseq(sample_data(design_field),
otu_table(fDAT_field_rare, taxa_are_rows=T),
tax_table(as.matrix(fTAX[rownames(fDAT_field_rare),])) )
### calculate alpha diverstiy indices
alpha_params_field <- estimate_richness(field_phy)
# Calculates Pielou's measure of species evenness, i.e. J = H/log(S) where H is Shannon diversity and S species richness
alpha_params_field$Pielou <- alpha_params_field$Shannon/log(alpha_params_field$Observed)
### plots
par(mar=c(6,4,5,0), oma=c(0,0,0,0), mfrow=c(1,3))
# Chao
bargraph.CI(design_field$groups, alpha_params_field$Chao1,
las=2, ylab="Chao1 richness (estimated)",
cex.lab=.8, cex.axis=.8, cex.names=.8, cex.main=.8,
err.width=.05, border=NA, col=levels(design_field$cols) )
# Shannon
bargraph.CI(design_field$groups, alpha_params_field$Shannon,
las=2, ylab="Shannon diversity)",
cex.lab=.8, cex.axis=.8, cex.names=.8, cex.main=.8,
err.width=.05, border=NA, col=levels(design_field$cols) )
# Pielou
bargraph.CI(design_field$groups, alpha_params_field$Pielou,
las=2, ylab="Pielou's evenness",
cex.lab=.8, cex.axis=.8, cex.names=.8, cex.main=.8,
err.width=.05, border=NA, col=levels(design_field$cols) )
### stats
# Chao
chao_lm <- lm(alpha_params_field$Observed ~ design_field$sample_type/design_field$plant_genotype)
chao_aov <- anova(chao_lm)
# summary(chao_aov)
# Shannon
shannon_lm <- lm(rank(alpha_params_field$Shannon) ~ design_field$sample_type/design_field$plant_genotype)
shannon_aov <- anova(shannon_lm)
# summary(shannon_aov)
# Pielou
pielou_lm <- lm(alpha_params_field$Pielou ~ design_field$sample_type/design_field$plant_genotype)
pielou_aov <- anova(pielou_lm)
# summary(pielou_aov)
field_PCoA_bray <- ordinate(field_phy, method="PCoA", distance="bray")
p1 <- plot_ordination(field_phy, field_PCoA_bray, color="groups", shape="sample_type")
p1 <- p1 + geom_point(size=3)
p1 <- p1 + scale_color_manual(values=levels(design_field$cols))
#p1 <- p1 + ggtitle("Field experiment: PCoA on Bray-Curtis distances")
print(p1)
# postscript("Field_PCoA_fungi.eps",
#            paper="special", width=7, height=6, horizontal=FALSE)
# print(p1)
# dev.off()
field_CAP_bray <- ordinate(field_phy, method="CAP", ~sample_type/plant_genotype, distance="bray")
# extract variation details
# source("functions/variability_table.R")
field_CAP_bray_var_tbl <- variability_table(field_CAP_bray)
# ANOVA
field_CAP_bray_anova <- anova.cca(field_CAP_bray, permutations=99999)
pander(field_CAP_bray_anova[1:4])
# plot
title <- paste("~sample_type/plant_genotype: [",
format(field_CAP_bray_var_tbl["constrained", "proportion"] * 100, digits=2, nsmall=1),
"% of variance; P = ",
format(field_CAP_bray_anova[1, 4], digits=2),
"]", sep = "")
p2 <- plot_ordination(field_phy, field_CAP_bray, type="samples", shape="sample_type", color="groups")
p2 <- p2 + geom_point(size=3)
p2 <- p2 + scale_color_manual(values=levels(design_field$cols))
p2 <- p2 + ggtitle(title)
p2 <- p2 + theme(plot.title = element_text(size=9, face = "bold"))
print(p2)
field_CAP_bray <- ordinate(field_phy, method="CAP", ~sample_type/plant_genotype, distance="bray")
# extract variation details
# source("functions/variability_table.R")
field_CAP_bray_var_tbl <- variability_table(field_CAP_bray)
# ANOVA
field_CAP_bray_anova <- anova.cca(field_CAP_bray, permutations=99999)
pander(field_CAP_bray_anova[1:4])
# plot
title <- paste("~sample_type/plant_genotype: [",
format(field_CAP_bray_var_tbl["constrained", "proportion"] * 100, digits=2, nsmall=1),
"% of variance; P = ",
format(field_CAP_bray_anova[1, 4], digits=2),
"]", sep = "")
p2 <- plot_ordination(field_phy, field_CAP_bray, type="samples", shape="sample_type", color="groups")
p2 <- p2 + geom_point(size=3)
p2 <- p2 + scale_color_manual(values=levels(design_field$cols))
p2 <- p2 + ggtitle(title)
p2 <- p2 + theme(plot.title = element_text(size=9, face = "bold"))
print(p2)
# postscript("Field_CAP_sampletype.genotype_fungi.eps", paper="special", width=7, height=6, horizontal = FALSE)
# print(p2)
# dev.off()
fDAT_field_rare_dist <- vegdist(t(fDAT_field_rare), method="bray")
fDAT_field_rare_dist_paov <- adonis(fDAT_field_rare_dist ~ sample_type/plant_genotype, data=design_field, permutations=99999)
pander(fDAT_field_rare_dist_paov$aov.tab[1:6])
# for Supplementary Table 1
capture.output(fDAT_field_rare_dist_paov, file="Table_Field_PERMANOVA_ITS.doc")
## Perform pairwise comparisions
# library(RVAideMemoire)
fDAT_field_rare_dist_pw_paov <- pairwise.perm.manova(fDAT_field_rare_dist, design_field$groups, nperm=99999)
pander(fDAT_field_rare_dist_pw_paov$p.value)
# for Supplementary Table 2
capture.output(fDAT_field_rare_dist_pw_paov, file="Table_Field_PERMANOVA_ITS_pairwise.doc")
## Perform BETADISP test of multivariate dispersions
fDAT_field_rare_dist_bdi <- betadisper(fDAT_field_rare_dist, design_field$groups, type="median")
fDAT_field_rare_dist_bdi_test <- permutest(fDAT_field_rare_dist_bdi, pairwise=T, permutations=how(nperm=9999))
pander( data.frame(fDAT_field_rare_dist_bdi_test$pairwise) )
# for Supplementary Table 2
capture.output(fDAT_field_rare_dist_bdi_test, file="Table_Field_BETADISP_ITS.doc")
### preparation of edgeR object
# library(edgeR)
## input data
# dim(fDAT_field_rare)
# colSums(fDAT_field_rare)[1:5]
# define abundant OTUs
field_threshold <- colSums(fDAT_field_rare)[1]/1000 # 6000/100*0.1, min 0.1% mean relative abundance
fDAT_field_rare_abundant <- fDAT_field_rare[rowMeans(fDAT_field_rare) >= field_threshold,]
# dim(fDAT_field_rare_abundant)
# range(colSums(fDAT_field_rare_abundant))
field_edgeR <- DGEList(counts=fDAT_field_rare_abundant,
group=design_field$groups,
genes=fTAX[rownames(fDAT_field_rare_abundant),])
### setting the model with one factor
# levels(design_field$groups)
field_edgeR_model <- model.matrix(~0 + design_field$groups )
# head(field_edgeR_model)
### estimate dispersion by weighted likelihood empirical Bayes
# use Empirical Robust Bayes Tagwise Dispersions, suggested by Mark Robinson
field_edgeR <- estimateGLMRobustDisp(field_edgeR, field_edgeR_model)
### fitting the model
field_edgeR_fit <- glmFit(field_edgeR, field_edgeR_model)
# colnames(field_edgeR_fit$coefficients)
### perform likelihood ratio tests
# makeContrasts(WT_Rhizo - bx1_Rhizo, levels=design_field$groups)   # define contrasts
field_rhizo_lrt <- glmLRT(field_edgeR_fit, contrast=c(0,1,0,-1,0))
# summary of differentially abundant OTUs
field_rhizo_edgeR_summary <- t(summary(decideTestsDGE(field_rhizo_lrt, p.value=0.05)))
colnames(field_rhizo_edgeR_summary) <- c("lower in WT", "unchanged", "higher in WT")
pander(field_rhizo_edgeR_summary)
# Identification of differentially abundant OTUs
field_rhizo_lrt_table <- topTags(field_rhizo_lrt, n=nrow(fDAT_field_rare), adjust.method="BH", sort.by="PValue", p.value=0.05)
field_rhizo_lrt_table[[1]]$Sample_type <- "rhizosphere"
field_rhizo_lrt_OTUs <- rownames(topTags(field_rhizo_lrt, n=nrow(fDAT_field_rare), adjust.method="BH", sort.by="PValue", p.value=0.05))
# field_rhizo_lrt_OTUs
pander(fTAX[field_rhizo_lrt_OTUs, c(2,3)], justify='left')
## Rhizosphere samples
Rhizosamples_WT <- rownames(design_field)[which(design_field$plant_genotype=="WT" & design_field$sample_type=="Rhizo")]
Rhizosamples_bx <- rownames(design_field)[which(design_field$plant_genotype=="bx1" & design_field$sample_type=="Rhizo")]
## calculation of means and SE
# WT and sorting for rank abundance
fDAT_field_norm_Rhizo_WT_MEAN <- apply(fDAT_field_norm[,Rhizosamples_WT], 1, mean)
fDAT_field_norm_Rhizo_WT_MEAN <- sort(fDAT_field_norm_Rhizo_WT_MEAN, decr=T)
fDAT_field_norm_Rhizo_WT_SE <- apply(fDAT_field_norm[,Rhizosamples_WT], 1, se)[names(fDAT_field_norm_Rhizo_WT_MEAN)]
# bx1
fDAT_field_norm_Rhizo_bx_MEAN <- apply(fDAT_field_norm[,Rhizosamples_bx], 1, mean)[names(fDAT_field_norm_Rhizo_WT_MEAN)]
fDAT_field_norm_Rhizo_bx_SE <- apply(fDAT_field_norm[,Rhizosamples_bx], 1, se)[names(fDAT_field_norm_Rhizo_WT_MEAN)]
# summary
fDAT_field_norm_Rhizo_MEANs <- cbind(fDAT_field_norm_Rhizo_WT_MEAN, fDAT_field_norm_Rhizo_bx_MEAN)
colnames(fDAT_field_norm_Rhizo_MEANs) <- c("WT","bx1")
fDAT_field_norm_Rhizo_SEs <- cbind(fDAT_field_norm_Rhizo_WT_SE, fDAT_field_norm_Rhizo_bx_SE)
colnames(fDAT_field_norm_Rhizo_SEs) <- c("WT","bx1")
## rank abundance plot
# postscript("Field_rhizo_profile_norm_MEANs_fungi.eps", paper="special", width=7, height=5, horizontal = FALSE)
par(mar=c(11,4,4,4), oma=c(0,0,0,0))
p <- barplot(t(fDAT_field_norm_Rhizo_MEANs)[,1:50], border=NA,
col=c("gold","palegreen2"), beside=T, las=2, ylim=c(0.001,12),
cex.names=.75, #main="Rhizosphere samples",
ylab=paste("relative abundance [%]",sep=" ") , xaxt="n")
# source("functions/staxlab.R")
staxlab(side=1, at=(p[1,]+p[2,])/2, labels=rownames(fDAT_field_norm_Rhizo_MEANs)[1:50], srt=45, cex=.5)
# legend
legend(x="topright", legend=colnames(fDAT_field_norm_Rhizo_MEANs), col=c("gold","palegreen2"), bty="n", xpd=TRUE, inset=c(0,0), pch=19, cex=1)
# error bars
arrows(x0=p, y0=t(fDAT_field_norm_Rhizo_MEANs)[,1:50], y1=t(fDAT_field_norm_Rhizo_MEANs)[,1:50] + t(fDAT_field_norm_Rhizo_SEs)[,1:50], angle=90, length=0.02, lwd=1)
# stats
stats_mw <- ifelse(rownames(fDAT_field_norm_Rhizo_MEANs) %in% field_rhizo_lrt_OTUs, "*","")
text(y=(apply(fDAT_field_norm_Rhizo_MEANs, 1, max)*1.75)[1:50], x=((p[1,] + p[2,])/2)[1:50], labels=stats_mw[1:50])
# dev.off()
### perform likelihood ratio tests
# makeContrasts(WT_Root - bx1_Root, levels=design_field$groups)   # define contrasts
field_root_lrt <- glmLRT(field_edgeR_fit, contrast=c(0,0,1,0,-1))
# summary of differentially abundant OTUs
field_root_edgeR_summary <- t(summary(decideTestsDGE(field_root_lrt, p.value=0.05)))
colnames(field_root_edgeR_summary) <- c("lower in WT", "unchanged", "higher in WT")
pander(field_root_edgeR_summary)
# Identification of differentially abundant OTUs
field_root_lrt_table <- topTags(field_root_lrt, n=nrow(fDAT_field_rare_abundant), adjust.method="BH", sort.by="PValue", p.value=0.05)
field_root_lrt_table[[1]]$Sample_type <- "root"
field_root_lrt_OTUs <- rownames(topTags(field_root_lrt, n=nrow(fDAT_field_rare_abundant), adjust.method="BH", sort.by="PValue", p.value=0.05))
# field_root_lrt_OTUs
pander(fTAX[field_root_lrt_OTUs, c(2,6)], justify='left')
### Database S4
write.table(rbind(field_root_lrt_table[[1]], field_rhizo_lrt_table[[1]]),
row.names=T, col.names=T, sep="\t", "Database_S4_field_its.txt")
## Root samples
Rootsamples_WT <- rownames(design_field)[which(design_field$plant_genotype=="WT" & design_field$sample_type=="Root")]
Rootsamples_bx <- rownames(design_field)[which(design_field$plant_genotype=="bx1" & design_field$sample_type=="Root")]
## calculation of means and SE
# WT and sorting for rank abundance
fDAT_field_norm_root_WT_MEAN <- apply(fDAT_field_norm[, Rootsamples_WT ], 1, mean)
fDAT_field_norm_root_WT_MEAN <- sort(fDAT_field_norm_root_WT_MEAN, decr=T)
fDAT_field_norm_root_WT_SE <- apply(fDAT_field_norm[, Rootsamples_WT ], 1, se)[names(fDAT_field_norm_root_WT_MEAN)]
# bx1
fDAT_field_norm_root_bx_MEAN <- apply(fDAT_field_norm[, Rootsamples_bx ], 1, mean)[names(fDAT_field_norm_root_WT_MEAN)]
fDAT_field_norm_root_bx_SE <- apply(fDAT_field_norm[, Rootsamples_bx ], 1, se)[names(fDAT_field_norm_root_WT_MEAN)]
# summary
fDAT_field_norm_root_MEANs <- cbind(fDAT_field_norm_root_WT_MEAN, fDAT_field_norm_root_bx_MEAN)
colnames(fDAT_field_norm_root_MEANs) <- c("WT","bx1")
fDAT_field_norm_root_SEs <- cbind(fDAT_field_norm_root_WT_SE, fDAT_field_norm_root_bx_SE)
colnames(fDAT_field_norm_root_SEs) <- c("WT","bx1")
## rank abundance plot
# postscript("Field_root_profile_norm_MEANs_fungi.eps", paper="special", width=7, height=5, horizontal = FALSE)
par(mar=c(11,4,4,4), oma=c(0,0,0,0))
p <- barplot(t(fDAT_field_norm_root_MEANs)[,1:50], border=NA,
col=c("gold2","palegreen3"), beside=T, las=2, ylim=c(0.001,32),
cex.names=.75, #main="Root samples",
ylab=paste("relative abundance [%]",sep=" ") , xaxt="n")
# source("functions/staxlab.R")
staxlab(side=1, at=(p[1,]+p[2,])/2, labels=rownames(fDAT_field_norm_root_MEANs)[1:50], srt=45, cex=.5)
# legend
legend(x="topright", legend=colnames(fDAT_field_norm_root_MEANs), col=c("gold2","palegreen3"), bty="n", xpd=TRUE, inset=c(0,0), pch=19, cex=1)
# error bars
arrows(x0=p, y0=t(fDAT_field_norm_root_MEANs)[,1:50], y1=t(fDAT_field_norm_root_MEANs)[,1:50] + t(fDAT_field_norm_root_SEs)[,1:50], angle=90, length=0.02, lwd=1)
# stats
stats_mw <- ifelse(rownames(fDAT_field_norm_root_MEANs) %in% field_root_lrt_OTUs, "*","")
text(y=(apply(fDAT_field_norm_root_MEANs, 1, max)*1.75)[1:50], x=((p[1,] + p[2,])/2)[1:50], labels=stats_mw[1:50])
# dev.off()
## library(VennDiagram)
# calculate numbers for Venn Diagram
a <- length(intersect(field_root_lrt_OTUs, field_rhizo_lrt_OTUs))
b <- length(field_root_lrt_OTUs)
c <- length(field_rhizo_lrt_OTUs)
# pdf( "Field_rhizo_vs_root_OTUs.pdf", width=4, height=4)
venn.plot <- draw.pairwise.venn(b, c, cross.area=a, cat.cex=.7,
category=c("Root","Rhizo"))
# dev.off()
field_edgeR_OTUs <- union(field_root_lrt_OTUs, field_rhizo_lrt_OTUs)
# fTAX[field_edgeR_OTUs,c(3,6)]
## plotting a few OTUs
# library(sciplot)
par(mar=c(6,4,4,2), oma=c(0,0,0,0), mfrow=c(1,2))
bargraph.CI(design_field$groups, fDAT_field_norm["fOTU98",],
las=2, ylab="relative abundance [%]",
cex.lab=.8, cex.axis=.8, cex.names=.8, cex.main=.8,
err.width=.05, border=NA, col=levels(design_field$cols),
main=paste("Field, fOTU98", fTAX["fOTU98", "genus"]), )
bargraph.CI(design_field$groups, fDAT_field_norm["fOTU20",],
las=2, ylab="relative abundance [%]",
cex.lab=.8, cex.axis=.8, cex.names=.8, cex.main=.8,
err.width=.05, border=NA, col=levels(design_field$cols),
main=paste("Field, fOTU20", fTAX["fOTU20", "genus"]), )
### design
design_feedback <- droplevels(design[design$exp=="feedback",])
# renaming sample groups
levels(design_feedback$groups) <- c("Rhizo_WT_BX+","Root_WT_BX+", "Rhizo_WT_BX-","Root_WT_BX-")
# library(pander)
design_feedback_summary <- table(design_feedback$groups)
pander(design_feedback_summary)
### data
fDAT_feedback <- fDAT[, rownames(design_feedback) ]
# range(colSums(fDAT_feedback))
# dim(fDAT_feedback)
## data normalization
# total sum as %
fDAT_feedback_norm <- t(t(fDAT_feedback)/colSums(fDAT_feedback)) * 100
fDAT_feedback_norm <- fDAT_feedback_norm[ rowSums(fDAT_feedback_norm) > 0,]
# dim(fDAT_feedback_norm)
# rarefication, library(vegan)
set.seed(3920)     # 3920 = zip code of Zermatt with lovely Matterhorn
fDAT_feedback_rare <- t(rrarefy(t(fDAT_feedback), min(colSums(fDAT_feedback))))
# remove rows having a sum count = 0
fDAT_feedback_rare <- fDAT_feedback_rare[rowSums(fDAT_feedback_rare) >= 1,]
#dim(fDAT_feedback_rare)
## Phyloseq object
# library(phyloseq)
# library(ggplot2)
# library(plyr)
feedback_phy <- phyloseq(sample_data(design_feedback),
otu_table(fDAT_feedback_rare, taxa_are_rows=T),
tax_table(as.matrix(fTAX[rownames(fDAT_feedback_rare),])) )
### calculate alpha diverstiy indices
alpha_params_feedback <- estimate_richness(feedback_phy)
# Calculates Pielou's measure of species evenness, i.e. J = H/log(S) where H is Shannon diversity and S species richness
alpha_params_feedback$Pielou <- alpha_params_feedback$Shannon/log(alpha_params_feedback$Observed)
### plots
par(mar=c(6,4,5,0), oma=c(0,0,0,0), mfrow=c(1,3))
# Chao
bargraph.CI(design_feedback$groups, alpha_params_feedback$Chao1,
las=2, ylab="Chao1 richness (estimated)",
cex.lab=.8, cex.axis=.8, cex.names=.8, cex.main=.8,
err.width=.05, border=NA, col=levels(design_feedback$cols) )
# Shannon
bargraph.CI(design_feedback$groups, alpha_params_feedback$Shannon,
las=2, ylab="Shannon diversity)",
cex.lab=.8, cex.axis=.8, cex.names=.8, cex.main=.8,
err.width=.05, border=NA, col=levels(design_feedback$cols) )
# Pielou
bargraph.CI(design_feedback$groups, alpha_params_feedback$Pielou,
las=2, ylab="Pielou's evenness",
cex.lab=.8, cex.axis=.8, cex.names=.8, cex.main=.8,
err.width=.05, border=NA, col=levels(design_feedback$cols) )
### stats
# Chao
chao_lm <- lm(alpha_params_feedback$Observed ~ design_feedback$sample_type * design_feedback$soil)
chao_aov <- anova(chao_lm)
# summary(chao_aov)
# Shannon
shannon_lm <- lm(rank(alpha_params_feedback$Shannon) ~ design_feedback$sample_type * design_feedback$soil)
shannon_aov <- anova(shannon_lm)
# summary(shannon_aov)
# Pielou
pielou_lm <- lm(alpha_params_feedback$Pielou ~ design_feedback$sample_type * design_feedback$soil)
pielou_aov <- anova(pielou_lm)
# summary(pielou_aov)
feedback_PCoA_bray <- ordinate(feedback_phy, method="PCoA", distance="bray")
p3 <- plot_ordination(feedback_phy, feedback_PCoA_bray, color="soil", shape="sample_type")
# p3 <- plot_ordination(feedback_phy, feedback_PCoA_bray, color="soil", shape="sample_type", label="sample_id")
p3 <- p3 + geom_point(size=3)
p3 <- p3 + scale_color_manual(values=levels(design_feedback$cols)[c(2,4)])
# p3 <- p3 + ggtitle("ITS feedback experiment, PCoA on Bray-Curtis distances")
plot(p3)
# postscript("Feedback_PCoA_fungi.eps",
#            paper="special", width=7, height=6, horizontal=FALSE)
# print(p3)
# dev.off()
fDAT_feedback_rare_dist <- vegdist(t(fDAT_feedback_rare), method="bray")
fDAT_feedback_rare_dist_paov <- adonis(fDAT_feedback_rare_dist ~ sample_type * soil, data=design_feedback, permutations=99999)
pander(fDAT_feedback_rare_dist_paov$aov.tab[1:6])
### Table 7
capture.output(fDAT_feedback_rare_dist_paov, file="Table_Feedback_PERMANOVA_ITS.doc")
## Perform pairwise comparisions
# library(RVAideMemoire)
fDAT_feedback_rare_dist_pw_paov <- pairwise.perm.manova(fDAT_feedback_rare_dist, design_feedback$groups, nperm=99999)
pander(fDAT_feedback_rare_dist_pw_paov$p.value)
# for Supplementary Table 8
capture.output(fDAT_feedback_rare_dist_pw_paov, file="Table_feedback_PERMANOVA_ITS_pairwise.doc")
## Perform BETADISP test of multivariate dispersions
fDAT_feedback_rare_dist_bdi <- betadisper(fDAT_feedback_rare_dist, design_feedback$groups, type="median")
fDAT_feedback_rare_dist_bdi_test <- permutest(fDAT_feedback_rare_dist_bdi, pairwise=T, permutations=how(nperm=9999))
pander( data.frame(fDAT_feedback_rare_dist_bdi_test$pairwise) )
# for Supplementary Table 8
capture.output(fDAT_feedback_rare_dist_bdi_test, file="Table_feedback_BETADISP_ITS.doc")
### subsetting to OTUs that belong to the 6 most abundant Phyla
phylum.sum <- tapply(taxa_sums(feedback_phy), tax_table(feedback_phy)[, "phylum"], sum, na.rm=T)
topphyla <- names(sort(phylum.sum, T))[1:6]
feedback_phy_sub <- prune_taxa((tax_table(feedback_phy)[, "phylum"] %in% topphyla), feedback_phy)
### CAP
feedback_sub_CAP_bray <- ordinate(feedback_phy_sub, method="CAP", ~sample_type*soil, distance="bray")
# extract variation details
# source("functions/variability_table.R")
feedback_sub_CAP_bray_var_tbl <- variability_table(feedback_sub_CAP_bray)
# ANOVA
feedback_sub_CAP_bray_anova <- anova.cca(feedback_sub_CAP_bray, permutations=99999)
# ANOVA
feedback_sub_CAP_bray_anova <- anova.cca(feedback_sub_CAP_bray, permutations=99999)
pander(feedback_sub_CAP_bray_anova[1:4])
s
# plot sample scores
title <- paste("~sample_type * soil: [",
format(feedback_sub_CAP_bray_var_tbl["constrained", "proportion"] * 100, digits=2, nsmall=1),
"% of variance; P = ",
format(feedback_sub_CAP_bray_anova[1, 4], digits=2),
"]", sep = "")
p4 <- plot_ordination(feedback_phy_sub, feedback_sub_CAP_bray, type="samples", shape="sample_type", color="soil")
p4 <- p4 + geom_point(size=3)
p4 <- p4 + scale_color_manual(values=levels(design_feedback$cols)[c(2,4)])
p4 <- p4 + ggtitle(title)
p4 <- p4 + theme(plot.title = element_text(size=9, face = "bold"))
print(p4)
pander(feedback_rhizo_edgeR_summary)
